PassZ.mesa 



2-Sep-78 12:69:59 



Page 1 



-- file PassZ.Mesa 

-- last modified by Satterthwaite, July 16. 1978 9:53 AM 

DIRECTORY 

ComData: FROM "comdata" 
USING [ 

bodylndex, bodyRoot, defBodyLimit, idLOCK. 

importCtx, mainBody, mainCtx, moduleCtx. 

monitored, nBodies, nSigCodes, textlndex]. 
CompilerDefs: FROM "compilerdef s" , 

ErrorDefs: FROM "errordefs" USING [error, errorhti, Warning]. 
SymDefs: FROM "symdefs" 
USING [ 

BodyLink, Bodylnfo, BodyRecord, ContextLevel , SERecord, TransferMode. 

HTIndex, SEIndex, CSEIndex, ISEIndex, recordCSEIndex. 

CTXIndex, BTIndex, CBTIndex. 

HTNull, SENull. CSENull, ISENull . recordCSENull . 

CTXNull, BTNull, CBTNull. 

IG, IL, IZ, typeANY, typeTYPE. 

setype, ctxtype, bodytype]. 
SymTabDefs: FROM "symtabdefs" 
USING C 

fillctxse, makenewctx, makenonctxse, makeSEChain. NameClash. 

nextlevel, NextSe. StaticNestError], 
TableDefs: FROM "tabledefs" 
USING [ 

TableBase, TableNotif ier. 

AddNotify, Allocate, DropNotify. TableBounds] , 
TreeDefs: FROM "treedefs" 
USING [ 

TreeLink, Treelndex, TreeMap, TreeScan. 

empty, nul ITreelndex, 

treetype, 

freenode, GetNode, listhead, listlength, 

scanlist, testtree, updatelist]; 

Pass2: PROGRAM 
IMPORTS 

ErrorDefs, SymTabDefs, TableDefs, TreeDefs. 
dataPtr: ComData 
EXPORTS CompilerDefs ■ 
BEGIN 
OPEN TreeDefs, SymTabDefs, SymDefs; 



tb: TableDefs. TableBase; 
seb: TableDefs. TableBase; 
ctxb: TableDefs. TableBase; 
bb: TableDefs. TableBase; 



-- tree base (private copy) 

-- se table base (private copy) 

-- context table base (private copy) 

-- body table base (private copy) 



Notify: TableDefs . TableNotif ier « 

BEGIN -- called by allocator whenever tables are repacked 

tb *- base[treetype]; 

seb ^ base[setype]; ctxb <- base[ctxtype]; 

bb <- base[bodytype]; 

RETURN 

END; 

Contextlnfo: TYPE « RECORD [ 
ctx: CTXIndex, 
staticLevel: ContextLevel, 
seChain: ISEIndex]; 

current: Contextlnfo; 



NewContext: PROCEDURE [level: ContextLevel, entries: CARDINAL, unique: BOOLEAN] 
BEGIN 

OPEN current; 
staticLevel ^ level ; 
IF entries « AND ^unique 

THEN BEGIN ctx ^ CTXNull; seChain <- ISENull END 
ELSE 
BEGIN 

ctx *- makenewctx[level]; 

(ctxb+ctx) .sel ist ♦- seChain ^ makeSEChain[ctx , entries, FALSE]; 
END; 
RETURN 
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END; 

-- main driver 

PZUnit: PUBLIC PROCEDURE [t: TreeLink] RETURNS [TreeLink] ■ 
BEGIN 

node: Treelndex; 
TableDefs.AddNotify[Notify]; 
node ^ GetNode[t]; 
BEGIN 

ENABLE -- default error reporting 
BEGIN 

NameClash ■> BEGIN ErrorDef s .errorhti[dupl icateld, hti]; RESUME END; 
StaticNestError ■> BEGIN ErrorDef s.error[staticNesting]; RESUME END; 
END; 
dataPtr. textlndex ^ (tb+node) . info; 

NewContext[1Z. 1 ist1ength[( tb+node) . sonl]+l is t1ength[( tb+node) .son3], FALSE]; 
dataPtr.moduleCtx ^ current. ctx; 
scan! ist[( tb+node) .sonl, IdDef inition]; 
scan! ist[{ tb+node) .son3, Module]; 
END; 
TableDefs.DropNotify[Notify]; 
RETURN [t] 
END; 

lockLambda: Treelndex; 

Module: TreeScan » 
BEGIN 

saved: Contextlnfo; 

savelndex: CARDINAL ■ dataPtr. textlndex; 
node: Treelndex = GetNode[t]; 

dataPtr. bodylndex <- CBTNull ; dataPtr. nBodies ♦- dataPtr .nSigCodes <- 0; 
btLink *- [which:parent, index:BTNun ]; 
dataPtr. textlndex ♦- (tb+node) . info; 
-- process import list 

saved ^ current; 

NewContext[lG, 1 is tlength[( tb+node) . sonl], FALSE]; 

dataPtr. importCtx ^ current. ctx; 

scan! ist[( tb+node) .sonl, IdDefinition]; 

current <- saved; 
dataPtr. monitored ^ (tb+node) . son4 # empty; 
lockLambda ^ Lambda[(tb+node) .son4. IL]; 
DeclList[(tb+node).son6, SENull]; 
BodyListCdataPtr.bodyRoot]; 

dataPtr. defBodyLimit <- TableDef s.TableBounds[bodytype] .size; 
dataPtr. textlndex ^ savelndex; RETURN 
END; 

IdDefinition: TreeScan » 
BEGIN 

node: Treelndex « GetNode[t]; 
savelndex: CARDINAL » dataPtr. textlndex; 
dataPtr . textlndex <- (tb+node) . info; 

(tb+node) . sonl *- Ids[list: (tb+node) . sonl. public: FALSE, link: node]; 
dataPtr. textlndex +- savelndex; RETURN 
END; 

-- monitor lock processing 

Lambda: PROCEDURE [item: TreeLink, level: ContextLevel ] RETURNS [node: Treelndex] 
BEGIN 

saved: Contextlnfo ■ current; 
node <- GetNode[item]; 
IF node # nullTreelndex 
THEN 

BEGIN 

NewContext[level , CountIds[(tb+node) .sonl] , FALSE]; 

(tb+node) . info <- current. ctx; 

Dec! Li st[( tb+node) .sonl, SENull]; 

IF (tb+node). son2 ^ empty THEN Exp[( tb+node) . son2] ; 

END; 
current <- saved; RETURN 
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END; 

ImplicitLock: PROCEDURE [sei: ISEIndex] - 
BEGIN 

WITH (tb+TockLambda).son2 SELECT FROM 
hash »> f inctxse[sei , index, FALSE]; 
ENDCASE ■> ERROR; 
BEGIN OPEN (seb+sei); 

extended ^ public <- writeonce *- constant ^ linkSpace +• FALSE; 
idtype ^ dataPtr . idLOCK; 
idinfo ♦- 1; idvalue <- nullTreelndex; 
marks <- TRUE; mark4 ^ FALSE; 
END; 

(tb+1ockLambda).son2 ^ [symbo1[index: sei]]; RETURN 
END; 

-- body processing 

btLink: BodyLink; 

AllocateBody: PROCEDURE [node: Treelndex] RETURNS [bti: CBTIndex] - 
BEGIN -- queue body for later processing 
dataPtr.nBodies <- dataPtr.nBodies+1; 
-- force nesting message here 

SELECT nextleve1[current.staticLevel] FROM 
IG, IL ■> 
BEGIN 

bti ♦- TableDefs.Anocate[bodytype, SIZE[Outer Callable BodyRecord]] ; 
(bb+bti)t <- BodyRecord[, , , , , CallableC ,,,,.. , Outer[]]]; 
END; 
ENDCASE -> 
BEGIN 
bti ♦- TableDefs,Allocate[bodytype, SIZE[Inner Callable BodyRecord]]; 

(bb+bti)t 4- BodyRecord[ CallableC ,.,,,, , Inner[]]]; 

END; 
(bb+bti).firstSon <- BTNull ; 
(bb+bti) . info *• BodyInfo[InternalC 
bodyTree: node, 

sourcelndex: dataPtr. textlndex, 
stOrigin: , 
frameSize: ]]; 
(bb+bti). id ^ IF (tb+node) .attrl 
THEN FirstId[(tb+node).sonl] 
ELSE ISENull; 
LinkBody[bti]; RETURN 
END; 

LinkBody: PROCEDURE [bti: BTIndex] - 
BEGIN 

IF btLink. which » parent 
THEN 
BEGIN 

(bb+bti). link <- btLink; 
IF btLink. index = BTNull 

THEN dataPtr.bodyRoot <■ bti 
ELSE (bb+btLink. index). firstSon <- bti; 
END 
ELSE 
BEGIN 

(bb+bti) .link ^ (bb+btLink. index) . 1 ink; 
(bb+btLink. index) . 1 ink <- [whichisibl ing. index: bti]; 
END; 
btLink <- [which: sibl ing, index: bti]; 
RETURN 
END; 

BodyList: PROCEDURE [firstBti: BTIndex] - 
BEGIN 

bti: BTIndex; 

IF (bti ^ firstBti) # BTNull 
THEN 
DO 
WITH (bb+bti) SELECT FROM 

Callable -> Body[LOOPHOLE[bti , CBTIndex]]; 



Pass2.m8sa 2-Sep-78 12:59:59 Page 



ENDCASE -> NULL; 

IF (bb+bti). link. which - parent THEN EXIT; 

bti ♦- (bb+bti). link. index; 

ENDLOOP; 
RETURN 
END; 

Body: PROCEDURE [bti: CBTIndex] ■ 
BEGIN 

node: Treelndex; 
bodyLevel : ContextLevel ; 
nLocks: [0..1]; 

oldBodylndex: CBTIndex ■ dataPtr .bodylndex; 
oldBtLink: BodyLink ■ btLink; 
saved: Contextlnfo ■ current; 
dataPtr. bodylndex ♦- bti; 
btLink <- [which:parent» index:bti]; 
WITH (bb+bti),info SELECT FROM 

Internal »> node ♦■ GetNode[(tb+LOOPHOLE[bodyTree, Treelndex]) .son3]; 
ENDCASE -> ERROR; 
bodyLevel ♦- nextlevel [saved . staticLevel IStaticNestError -> RESUME]; 
nLocks <- IF dataPtr. monitored AND 

bodyLevel « IG AND (tb+lockLambda) .attrl THEN 1 ELSE 0; 
NewContext[ 

level: bodyLevel, 

entries: nLocks + CountIds[(tb+node) .son2], 

unique: bodyLevel » IG]; 
(bb+bti) . localCtx ♦- current. ctx; (bb+bti) . level <- bodyLevel; 
(bb+bti) .monitored <- nLocks # 0; 
IF bodyLevel » IG 

THEN BEGIN dataPtr .mainCtx ♦- current. ctx; dataPtr, mainBody ♦- bti END; 
scan! ist[(tb+node) .sonl, Exp]; 
IF nLocks # 
THEN 

BEGIN 

Impl icitLock[current.seChain]; 

current. seChain ♦- NextSe[current. seChain] 

END; 
DeclList[{tb+node).son2, SENull]; 
scanl ist[(tb+node) .son3, Stmt]; 
BodyList[(bb+bti).firstSon]; 

current <- saved; dataPtr. bodylndex ^ oldBodylndex; btLink <- oldBtLink; 
RETURN 
END; 

Inline: TreeScan ■ 
BEGIN 

scamist[t, Exp]; RETURN 
END; 

-- declarations 

DeclList: PROCEDURE [t: TreeLink, linkld: SEIndex] ■ 
BEGIN 

Declltem: TreeScan - 
BEGIN 

node: Treelndex « GetNode[t]; 
subNode: Treelndex; 

savelndex: CARDINAL - dataPtr . textlndex; 
dataPtr. textlndex *- (tb+node) . info; 
(tb+node) .mark ♦- FALSE; 
(tb+node) .sonl <- Ids[ 

list: (tb+node) .sonl. 
public: (tb+node). attr2. 
link: node]; 
IF testtree[(tb+node) .son2, modeTC] 

THEN TypeExp[(tb+node).son3. Firstld[( tb+node) . sonl], linkld] 
ELSE 
BEGIN 

TypeExp[{tb+node).son2. SENull. linkld]; 
IF (tb+node) . son3 /^ empty AND (tb+node) . son3. tag ■ subtree 
THEN 
BEGIN 
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subNode <- GetNode[(tb+node) .son3]; 
SELECT (tb+subNode).name FROM 
entry, internal ■> 
BEGIN 

IF '-dataPtr. monitored OR ^-testtreeCCtb+subNode) .sonl, body] 
THEN ErrorDefs.error[misplacedEntry] 
ELSE 
BEGIN 

WITH (tb+subNode).sonl SELECT FROM 
subtree ■> 

SELECT (tb+subNode).name FROM 

entry -> (tb+index) .attrl <- TRUE; 
internal ■> (tb+index) .attrZ ♦■ TRUE; 
ENDCASE; 
ENDCASE; 
IF (tb+subNode) .name - internal AND (tb+node) .attrE 

THEN Er rorDefs. Warn ing[attrCl ash]; 
END; 
(tb+node) .son3 ^ (tb+subNode) .sonl; 
(tb+subNode) .sonl ^ empty; freenode[subNode]; 
END; 
ENDCASE; 
END; 
IF (tb+node) .son3 ^ empty 
THEN 

WITH (tb+node). sons SELECT FROM 
subtree »> 

SELECT (tb+index). name FROM 

body => (tb+index) . info <- AllocateBody[node]; 
signalinit »> 
BEGIN 

(tb+index) .info ♦■ dataPtr.nSigCodes; 
dataPtr.nSigCodes ^ dataPtr.nSigCodes+1; 
END; 
inline «> scanl ist[(tb+index) .sonl. Inline]; 
ENDCASE => Exp[(tb+node).son3]; 
ENDCASE «> Exp[(tb+node).son3]; 
END; 
dataPtr.textlndex <- savelndex; RETURN 
END; 

scanl ist[root:t, action:Decl Item]; RETURN 
END; 



Countlds: PROCEDURE [declList: TreeLink] RETURNS [n: CARDINAL] 
BEGIN 

nids: TreeScan ■ 
BEGIN 

node: Treelndex » GetNode[t]; 
n ♦- n + 1 istlength[(tb+node).sonl]; 
RETURN 
END; 

n ♦- 0; scanlist[declList. nIds]; RETURN 
END; 



-- id 1 ist manipulation 

Ids: PROCEDURE [list: TreeLink, public: BOOLEAN, link: Treelndex] 
RETURNS [TreeLink] - 
BEGIN 

Id: TreeMap » 
BEGIN 

hti: HTIndex; 
sei: ISEIndex; 

ctx: CTXIndex - current. ctx; 
WITH t SELECT FROM 

hash ■> hti ♦- index; 

symbol «> hti ^ ( seb+index) . htptr; 

ENDCASE «> ERROR; 
sei <- current .seChain; current . seChain ^ NextSe[current. seChain]; 
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finctxs8[sei , hti , public]; 

V ^ TreeLink[synibo1[index: sei]]; 

(seb+sei) .idtype ♦- typeANY; 

(seb+sei) .public <- public; 

(seb+sei) . idvalue ^ link; 

(seb+sei) .extended ♦- (seb+sei) . 1 inkSpace ♦- FALSE; 

RETURN 

END; 

RETURN [updatelist[root:list, map:Id]] 
END; 

Firstid: PROCEDURE [t: TreeLink] RETURNS [ISEIndex] - 
BEGIN 

head: TreeLink ■ listhead[t]; 
WITH head SELECT FROM 

symbol ■> RETURN [index]; 

ENDCASE ■> ERROR; 
END; 

-- type manipulation 

TypeExp: PROCEDURE [t: TreeLink, typeld. linkld: SEIndex] - 
BEGIN ~- processes type-node of declitem subtree 
node: Treelndex; 
sei: CSEIndex; 
tCtx: CTXIndex; 
nFields: CARDINAL; 
WITH t SELECT FROM 
subtree ■> 

BEGIN node ^ index; 
SELECT (tb+node).name FROM 
modeTC »> sei ^ typeTYPE; 
enumeratedTC »> 
BEGIN 

sei ^ makenonctxse[SIZE[enumerated constructor SERecord]]; 
tCtx ^ Enumerationfnode]; 
(seb+sei) .typeinfo *- enumerated[ 
ordered: TRUE, 
valuectx: tCtx, 
nvalues: ]; 
AssignValues[sei. IF typeld # SENull THEN typeld ELSE sei]; 
END; 
recordTC, monitoredTC •> 
BEGIN 

sei ♦- makenonctxse[SIZE[notl inked record constructor SERecord]]; 
[tCtx, nFields] ^ FieldList[ 
t: (tb+node) .sonl. 
level: IZ, 

typeld: IF typeld ff SENull THEN typeld ELSE sei]; 
(seb+sei ) .typeinfo <- record[ 

machineDep: (tb+node) .attrl ♦ 
unifield: nFields - 1 AND '-(tb+node) . attrZ. 
argument: FALSE, 
defauUFields: FALSE, 
length: , 

comparable: FALSE, 
privateFields: FALSE, 
lengthUsed: FALSE, 
fieldctx: tCtx, 

monitored: (tb+node) . name ■ monitoredTC, 
variant: (tb+node) . attr2. 
linkpart: notl inked[]] ; 
END; 
variantTC "> 
BEGIN 

sei ^ makenonctxse[SIZE[l inked record constructor SERecord]]; 
tCtx <- FieldList[t: (tb+node) .sonl, level:lZ, typeld: typeld]. ctx; 
(seb+sei ). typeinfo ^ record[ 

machineDep: (tb+node) .attrl, 
unifield: FALSE, 
argument: FALSE, 
defauUFields: FALSE, 
length: , 
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comparable: FALSE. 
privateFields: FALSE. 
lengthUsed: FALSE, 
fieldctx: tCtx. 
monitored: FALSE, 
variant: (tb+node) ,attr2. 
linkpart: 1 ink8d[1 inkid]]; 
END; 
pointerTC •> 

BEGIN sei ^ makenonctxse[SIZE[pointer constructor SERecord]]; 
(seb+sei) .typeinfo <- pointer[ 
ordered: (tb+node) .attrl. 
basing: (tb+node) . attr2, 
readonly: FALSE, 
dereferenced: FALSE, 
pointedtotype: ]; 
TypeExp[(tb+node).sonl, SENull , SENull]; 
END; 
arrayTC ■> 

BEGIN sei *■ makenonctxse[SIZE[array constructor SERecord]]; 
(seb+sei) .typeinfo ^ array[ 
packed: (tb+node) . attrl, 
lengthUsed: FALSE, 
comparable: FALSE, 
indextype: , 
componenttype: ]; 
IF (tb+node) .sonl f^ empty 

THEN TypeExp[(tb+node).sonl, SENull, SENull]; 
TypeExp[(tb+node).son2, SENull. SENull]; 
END; 
arraydescTC ■> 

BEGIN sei <- makenonctxse[SIZE[arraydesc constructor SERecord]]; 
(seb+sei) .typeinfo <- arraydesc[describedType: ]; 
TypeExp[(tb+node).sonl, SENull. SENull]; 
END; 
procTC «> sei <- Transfer[node, procedure]; 
portTC «> sei *- Transfer[node, port]; ' 
signalTC »> sei ^ Transfer[node, signal]; 
errorTC «> sei <- Transfer[node. error]; 
processTC ■> sei ♦- Transfer[node, process]; 
programTC «> sei ♦- Transfer[node, program]; 
definitionTC ■> 
BEGIN 

sei <- makenonctxse[SIZE[def inition constructor SERecord]]; 
(seb+sei) .typeinfo ♦- def inition[nGf i : 1, defCtx: ]; 
END; 
unionTC «> sei <- Union[node, linkld]; 
relativeTC ■> 
BEGIN 

sei ^ makenonctxse[SIZE[relative constructor SERecord]]; 
(seb+sei) .typeinfo ♦- relattve[ 
baseType: , 
offsetType: , 
resultType: ]; 
TypeExp[(tb+node).sonl, SENull. SENull]; 
TypeExp[(tb+node).son2. SENull, SENull]; 
END; 
subrangeTC «> 

BEGIN sei ^ makenonctxse[SIZE[subrange constructor SERecord]]; 
(seb+sei) .typeinfo ♦- subrange[ 
filled: FALSE, 
empty: FALSE, 
flexible: FALSE, 
rangetype: , 
origin: , 
range: ]; 
TypeExp[(tb+node).sonl, SENull. SENull]; 
Interval [(tb+node) .son2]; 
END; 
longTC •> 

BEGIN sei ♦- makenonctxse[SIZE[long constructor SERecord]]; 
(seb+sei) .typeinfo ♦- long[rangetype: ]; 
TypeExp[(tb+node).sonl. SENull, SENull]; 
END; 
implicitTC, frameTC ■> sei ^ CSENull ; 
dot, discrimTC ••> 
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BEGIN TypeExp[(tb+node).sonl, SENull . SENull]; sei <- CSENull ; 
END; 
ENDCASE -> 
BEGIN sei 4- CSENull; ErrorDef s.error[nonTypeCons] END; 
(tb+node) .info ^ sei; 
END; 
ENDCASE ■> NULL; 
RETURN 
END; 

Enumeration: PROCEDURE [node: Treelndex] RETURNS [ctx: CTXIndex] ■ 
BEGIN 

saved: Contextlnfo ■ current; 

NewContext[lZ, 1 istlength[(tb+node) . sonl], TRUE]; ctx <- current. ctx; 
(tb+node) .sonl ^ Ids[ 

list: (tb+node) .sonl, 

public: (tb+node) .attrl, 

link: nullTreelndex]; 
current ^ saved; RETURN 
END; 

AssignValues: PROCEDURE [type: CSEIndex, valueType: SEIndex] ■ 
BEGIN 

i: CARDINAL; 
sei: ISEIndex; 
WITH (seb+type) SELECT FROM 
enumerated ■> 
BEGIN i <- 0; 

FOR sei <- (ctxb+valuectx).se1 ist. NextSe[sei] UNTIL sei » SENull 
DO OPEN (seb+sei); 
idtype ♦- valueType; idinfo <- 0; 
idvalue ^ i ; i ♦- i+1; 

writeonce +• constant ^ mark3 ♦- mark4 ♦- TRUE; 
ENDLOOP; 
nvalues ♦- i; 
END; 
ENDCASE -> ERROR; 
END; 

FieldList: PROCEDURE [t: TreeLink, level: ContextLevel , typeld: SEIndex] 
RETURNS [ctx: CTXIndex, nFields: CARDINAL] « 
BEGIN 

saved: Contextlnfo » current; 
nFields ♦- CountIds[t]; 

NewContext[level . nFields. TRUE]; ctx <- current. ctx; 
DeclList[t, typeld]; 
current <- saved; RETURN 
END; 

Transfer: PROCEDURE [node: Treelndex, mode: TransferMode] RETURNS [sei: CSEIndex] 
BEGIN 

tSeil, tSei2: recordCSEIndex; 

sei <- makenonctxse[SIZE[transfer constructor SERecord]]; 
tSeil ^ ArgList[( tb+node) .sonl]; 
tSeiZ <- ArgList[(tb+nod8) .son2]; 
(seb+sei) .typeinfo ♦- transfer[ 

mode: mode, 

inrecord: tSeil. 

outrecord: tSei2]; 
RETURN 
END; 

ArgList: PROCEDURE [t: TreeLink] RETURNS [type: recordCSEIndex] - 
BEGIN 

tCtx: CTXIndex; 
nFields: CARDINAL; 
IF t « empty 

THEN type ♦- recordCSENull 
ELSE 
BEGIN 

type <- LOOPHOLE[makenonctxse[SIZE[notl inked record constructor SERecord]]]; 
[tCtx, nFields] ^ FieldList[t, nextlevel[current.staticLevel], type]; 
(seb+type) .typeinfo <- record[ 
machineDep: FALSE, 
unifield: nFields - 1, 
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argument: TRUE, 

defauUFields: FALSE. 

length: . 

comparable: FALSE, 

privateFields: FALSE. 

lengthUsed: FALSE. 

fieldctx: tCtx, 

monitored: FALSE, 

variant: FALSE, 

linkpart: not1inked[]]; 
END; 
RETURN 
END; 

Union: PROCEDURE [node: Treelndex, linkld: SEIndex] RETURNS [sei: CSEIndex] 
BEGIN 

tagid: ISEIndex; 
subnode: Treelndex; 
saved: Contextlnfo » current; 

current. ctx ♦- CTXNull ; current. seChain <- makeSEChain[CTXNun . 1, FALSE]; 
Dec1List[(tb+node) .sonl. SENull]; 
subnode ♦- GetNode[(tb+node) . sonl] ; 
tagId <- FirstId[(tb+subnode) .sonl]; 
WITH (tb+subnode).son2 SELECT FROM 
subtree -> 

IF (tb+index) .name » implicitTC 

THEN (tb+index). info <- MakeTagType[(tb+node) . son2]; 
ENDCASE ■> NULL; 
NewContext[1Z, CountIds[(tb+node) .son2] . TRUE]; 
Dec1List[(tb+node) .son2, linkld 
INameClash -> 
BEGIN ErrorDefs.errorhti[duplicateTag. hti]; RESUME END]; 
sei <- makenonctxse[SIZE[union constructor SERecord]]; 
(seb+sei) . typeinfo ♦- union[ 

casectx: current. ctx, 
overlayed: (tb+node) . attrl . 
controlled: (seb+tagid) .htptr # HFNull, 
tagsei: tagId, 
equalLengths: FALSE]; 
current *- saved; RETURN 
END; 

MakeTagType: PROCEDURE [t: TreeLink] RETURNS [type: CSEIndex] - 
BEGIN 
saved: Contextlnfo » current; 

CollectTags: TreeScan - 
BEGIN 

node: Treelndex « GetNode[t]; 
(tb+node) .sonl <- Ids[ 

list: (tb+node) .sonl, 

public: (tb+node) .attr2, 

link: nullTreelndex 
INameClash =»> RESUME]; 
RETURN 
END; 

NewContext[lZ, CountIds[t]. TRUE]; 

type <- makenonctxse[SIZE[enumerated constructor SERecord]]; 

(seb+type) .typeinfo ♦- enumerated[ 

ordered: FALSE, 

valuectx: current. ctx, 

nvalues: ]; 
scanlist[t, CollectTags]; 
AssignValues[type, type]; 
current <- saved; RETURN 
END; 



-- statements 

Stmt: PROCEDURE [stmt: TreeLink] - 
BEGIN 
node, subNode: Treelndex; 
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savelndex: CARDINAL ■ dataPtr. textlndex; 
IF stmt - empty THEN RETURN; 
WITH stmt SELECT FROM 
subtree ■> 

BEGIN node ^ index; 

dataPtr. textlndex ♦- (tb+node) .info; 

SELECT (tb+node). name FROM 

assign ■> BEGIN Exp[(tb+node) .sonl]; Exp[(tb+node) .sonZ] END; 
extract ■> 

BEGIN scanlist[(tb+node).sonl. Exp]; Exp[(tb+node) .sonZ] END; 
apply "> 
BEGIN 

Exp [(tb+node) .sonl]; scan! i st[( tb+node) .son2, Exp]; 
IF (tb+node). nsons > 2 THEN CatchPhrase[(tb+node) .son3]; 
END; 
block ■> Block[node]; 
ifstmt ■> 

BEGIN OPEN (tb+node); 

Exp[sonl]; scan! ist[son2, Stmt]; scanlist[son3, Stmt]; 
END; 
casestmt ■> 

BEGIN OPEN (tb+node); 

Exp[sonl]; SelectionList[son2, Stmt]; Stmt[son3]; 
END; 
bindstmt ■> 

BEGIN OPEN (tb+node); 
Exp[sonl] ; 

IF son2 # empty THEN Exp[son2]; 
SelectionList[son3, Stmt]; 
Stmt[son4]; 
END; 
dostmt ■> 

BEGIN OPEN (tb+node); 
IF sonl # empty 
THEN 

BEGIN subNode ♦■ 6etNode[sonl]; 

IF (tb+subNode) .sonl # empty THEN Exp[(tb+subNode) .sonl]; 
SELECT (tb+subNode). name FROM 
forseq ■> 
BEGIN 

Exp[( tb+subNode) .son2]; Exp[( tb+subNode) .son3]; 
END; 
upthrut downthru ■> Range[( tb+subNode) . son2]; 
ENDCASE »> ERROR; 
END; 
IF son2 # empty THEN Exp[son2]; 
scanlist[son3, Exp]; 

scanlist[son4, Stmt]; scanl ist[son5, Stmt]; scanl ist[son6. Stmt]; 
END; 
return, resume »> scan! ist[(tb+node) .sonl, Exp]; 
label «> 
BEGIN 

scanlist[(tb+node) .sonl, Stmt]; scanl ist[(tb+node) .son2, Stmt]; 
END; 
goto, exit, loop, continue, retry; syserror, nullstmt ■> NULL; 
signal, error, xerror, start, restart, 
join, wait, notify, broadcast, dst, 1st, Istf »> 

Exp[( tb+node) .sonl] ; 
stop -> IF (tb+node) .sonl # empty THEN CatchPhrase[(tb+node) .sonl]; 
openstmt ■> 
BEGIN 

scanl ist[(tb+node) .sonl. Exp]; scanl ist[( tb+node) . son2. Stmt]; 
END; 
enable »> 
BEGIN 

CatchPhrase[(tb+node).sonl]; scanl ist[(tb+node) . son2; Stmt]; 
END; 
list ■> scanlist[stmt. Stmt]; 
item "> Stmt[(tb+node) .son2]; 
ENDCASE «> ErrorDef s .error[unimplemented]; 
END; 
ENDCASE -> NULL; 
dataPtr .textlndex <- savelndex; RETURN 
END; 
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Block: PROCEDURE [node: Treelndex] ■ 
BEGIN 

bti: BTIndex; 
oldBtLink: BodyLink; 
saved: Contextlnfo ■ current; 
NewContext[ 

level: saved. staticLevel , 

entries: CountIds[(tb+node) .sonl], 

unique: FALSE]; 
bti ♦- TableDefs.Anocate[bodytype, SIZE[Other BodyRecord]]; 
(bb+bti)t i- BodyRecord[ 

link: . 

firstSon: BTNull . 

localCtx: current. ctx, 

level: current. staticLevel , 

info: BodyInfo[Internal[ 
bodyTree: node, 
sourcelndex: (tb+node) .info, 
stOrigin: , 
frameSize: ]]. 

extension: OtherC]]; 
LinkBody[bti]; oldBtLink ^ btLink; btLink ♦- [which:parent, index:bti]; 
(tb+node) . info <- bti ; 
DeclListC(tb+node) .sonl, SENull]; 
scanlist[(tb+node) .son2, Stmt]; 
BodyList[(bb+bti). firstSon]; 
current ♦- saved; btLink ^ oldBtLink; RETURN 
END; 

SelectionList: PROCEDURE [t: TreeLink, selection: TreeScan] - 
BEGIN 

Item: TreeScan ■ 
BEGIN 

node: Treelndex » GetNode[t]; 
savelndex: CARDINAL ■ dataPtr . textlndex; 
dataPtr.textlndex <- (tb+node) . info; 

scanl ist[(tb+node) .sonl, Exp]; selection[(tb+node) .son2]; 
dataPtr.textlndex ^ savelndex; RETURN 
END; 

scanlist[t. Item]; RETURN 
END; 

CatchPhrase: PROCEDURE [t: TreeLink] - 
BEGIN 

node: Treelndex * GetNode[t]; 
saved: Contextlnfo = current; 
NewContext[ 

level : nextlevel[saved. staticLevel], 

entries: 0, 

unique: FALSE]; 
SelectionList[( tb+node) .sonl, Stmt]; 

IF (tb+node) .nsons > 1 THEN scanl ist[(tb+node) . son2, Stmt]; 
current ^ saved; RETURN 
END; 

-- expressions 

Exp: PROCEDURE [exp: TreeLink] - 
BEGIN 

node, subNode: Treelndex; 
IF exp - empty THEN RETURN; 
WITH exp SELECT FROM 
subtree ■> 

BEGIN node ♦- index; 
SELECT (tb+node). name FROM 
apply -> 
BEGIN 

Exp[(tb+node) .sonl] ; scanl ist[(tb+node) . son2. Exp]; 
IF (tb+node). nsons > 2 THEN CatchPhrase[( tb+node) .son3]; 
END; 
signal, error, start, fork, join. 
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dot, uparrow. 

uminus, lengthen, float, abs, not, 

addr, base, length, register, memory, new ■> 

Exp[(tb+node).sonl]; 
plus, minus, times, div, mod, 
relE. relN, relL, relGE, relG, relLE. 
or, and, assignx ■> 

BEGIN Exp[(tb+node).sonl]; Exp[(tb+node) .son2] END; 
in, notin ■> 

BEGIN Exp[(tb+node).sonl]; RangeC(tb+node) . son2] END; 
ifexp ■> 
BEGIN 

Exp[(tb+node).sonl]; Exp[(tb+node) . son2]; Exp[(tb+node) ,son3]; 
END; 
caseexp ■> 

BEGIN OPEN (tb+node); 

Exp[sonl]; SelectionList[son2, Exp]; Exp[son3]; 
END; 
bindexp ■> 
BEGIN OPEN (tb+node); 
Exp[sonl]; 

IF son2 # empty THEN Exp[son2]; 
SelectionList[son3, Exp]; 
Exp[son4]; 
END; 
min, max ■> scanl istC(tb+node) .sonl, Exp]; 
arraydesc ■> 

SELECT listlength[(tb+node).sonl] FROM 
1 "> Exp[(tb+node) .sonl]; 
3 ■> 
BEGIN 

subNode <- GetNode[(tb+node) .sonl]; 
Exp [(tb+subNode). sonl]; Exp[(tb+subNode) .son2]; 
IF (tb+subNode) .son3 # empty 

THEN TypeExp[(tb+subNode).son3, SENull, SENull]; 
END; 
ENDCASE ■> ERROR; 
clit, Hit, mwconst ■> NULL; 
loophole ■> 
BEGIN 

Exp[( tb+node) .sonl]; 
IF (tb+node) .son2 # empty 

THEN TypeExp[(tb+node).son2, SENull, SENull]; 
END; 
size, first, last ■> TypeExp[(tb+node) .sonl, SENull, SENull]; 
item «> Exp[(tb+node) .son2]; 
ENDCASE '■> ErrorDefs .error[unimplemented]; 
END; 
ENDCASE ■> NULL; 
RETURN 
END; 

Interval: PROCEDURE [t: TreeLink] - 
BEGIN 

node: Treelndex ■ GetNode[t]; 

Exp[( tb+node). sonl]; Exp[( tb+node) . son2] ; RETURN 
END; 

Range: PROCEDURE [t: TreeLink] - 
BEGIN 

node: Treelndex; 
WITH t SELECT FROM 
subtree «> 

BEGIN node ♦■ index; 
SELECT (tb+node). name FROM 
subrangeTC ■> 
BEGIN 

TypeExp[(tb+node).sonl, SENull, SENull]; Interval[(tb+node) .son2]; 
END; 
IN [intOO .. intCC] -> Interval[t]; 
ENDCASE -> TypeExp[t, SENull, SENull]; 
END; 
ENDCASE ■> TypeExp[t, SENull, SENull]; 
RETURN 
END; 
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END. 



